home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr34 / tarchiv.zip / TAPESERV.PAS < prev    next >
Pascal/Delphi Source File  |  1995-01-27  |  3KB  |  133 lines
  1. {************************************************}
  2. {                                                }
  3. {                                                }
  4. {************************************************}
  5.  
  6. program TapeServer;
  7.  
  8. uses Objects, Drivers, Views, Menus, Dialogs, App;
  9.  
  10. const
  11.   cmSettings = 100;
  12.  
  13. type
  14.   TDialogData = record
  15.     CheckBoxData: Word;
  16.     RadioButtonData: Word;
  17.     InputLineData: string[128];
  18.   end;
  19.  
  20.   TMyApp = object(TApplication)
  21.     DialogData : TDialogData;
  22.     procedure HandleEvent(var Event: TEvent); virtual;
  23.     procedure InitMenuBar; virtual;
  24.     procedure InitStatusLine; virtual;
  25.     procedure Settings;
  26.   end;
  27.  
  28.   PDemoDialog = ^TDemoDialog;
  29.   TDemoDialog = object(TDialog)
  30.   end;
  31.  
  32. { TMyApp }
  33. procedure TMyApp.HandleEvent(var Event: TEvent);
  34. begin
  35.   TApplication.HandleEvent(Event);
  36.   if Event.What = evCommand then
  37.   begin
  38.     case Event.Command of
  39.       cmSettings: Settings;
  40.     else
  41.       Exit;
  42.     end;
  43.     ClearEvent(Event);
  44.   end;
  45. end;
  46.  
  47. procedure TMyApp.InitMenuBar;
  48. var R: TRect;
  49. begin
  50.   GetExtent(R);
  51.   R.B.Y := R.A.Y + 1;
  52.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  53.     NewSubMenu('~A~ctions', hcNoContext, NewMenu(
  54.       NewLine(
  55.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  56.       nil))),
  57.     NewSubMenu('~S~etup', hcNoContext, NewMenu(
  58.       NewItem('~C~hange settings', 'F2', kbF2, cmSettings, hcNoContext,
  59.       nil)),
  60.     nil))
  61.   )));
  62. end;
  63.  
  64. procedure TMyApp.InitStatusLine;
  65. var R: TRect;
  66. begin
  67.   GetExtent(R);
  68.   R.A.Y := R.B.Y - 1;
  69.   StatusLine := New(PStatusLine, Init(R,
  70.     NewStatusDef(0, $FFFF,
  71.       NewStatusKey('', kbF10, cmMenu,
  72.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  73.       nil)),
  74.     nil)
  75.   ));
  76. end;
  77.  
  78. procedure TMyApp.Settings;
  79. var
  80.   Bruce: PView;
  81.   Dialog: PDemoDialog;
  82.   R: TRect;
  83.   C: Word;
  84. begin
  85.   R.Assign(20, 6, 60, 19);
  86.   Dialog := New(PDemoDialog, Init(R, 'Demo Dialog'));
  87.   with Dialog^ do
  88.   begin
  89.     R.Assign(3, 3, 18, 6);
  90.     Bruce := New(PCheckBoxes, Init(R,
  91.       NewSItem('~H~varti',
  92.       NewSItem('~T~ilset',
  93.       NewSItem('~J~arlsberg',
  94.       nil)))
  95.     ));
  96.     Insert(Bruce);
  97.     R.Assign(2, 2, 10, 3);
  98.     Insert(New(PLabel, Init(R, 'Cheeses', Bruce)));
  99.     R.Assign(22, 3, 34, 6);
  100.     Bruce := New(PRadioButtons, Init(R,
  101.       NewSItem('~S~olid',
  102.       NewSItem('~R~unny',
  103.       NewSItem('~M~elted',
  104.       nil)))
  105.     ));
  106.     Insert(Bruce);
  107.     R.Assign(21, 2, 33, 3);
  108.     Insert(New(PLabel, Init(R, 'Consistency', Bruce)));
  109.     R.Assign(3, 8, 37, 9);
  110.     Bruce := New(PInputLine, Init(R, 128));
  111.     Insert(Bruce);
  112.     R.Assign(2, 7, 24, 8);
  113.     Insert(New(PLabel, Init(R, 'Delivery instructions', Bruce)));
  114.     R.Assign(15, 10, 25, 12);
  115.     Insert(New(PButton, Init(R, '~O~k', cmOK, bfDefault)));
  116.     R.Assign(28, 10, 38, 12);
  117.     Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  118.   end;
  119.   Dialog^.SetData(DialogData);
  120.   C := DeskTop^.ExecView(Dialog);
  121.   if C <> cmCancel then Dialog^.GetData(DialogData);
  122.   Dispose(Dialog, Done);
  123. end;
  124.  
  125. var
  126.   MyApp: TMyApp;
  127.  
  128. begin
  129.   MyApp.Init;
  130.   MyApp.Run;
  131.   MyApp.Done;
  132. end.
  133.